unit XTASACS;
(* Purpose: This unit defines the interface between delphi and the fortran
            TASACS  functions. Dll ordinals are attached and wrapped up in
            delphi functions. This interface can be by a delphi frontend.
   History  When       Who       What
            07-05-08   Skalevik  Created
*)


interface

uses strutils, sysutils, index, parameter, TASACSConfigtypes, math;

const s_TASACS_Dll = 'TASACS.dll'; // must resist in the same folder as running


//type PDouble = ^double;

procedure CreateNewProject__(var ProjectDir : string256; var FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass : Integer); stdcall;
   external s_TASACS_Dll name '_CreateNewProject_@32'
procedure Execute__(var CmdId : Integer; var Param1 : integer); stdcall;
   external s_TASACS_Dll name '_Execute_@8'
procedure LoadRun__(var ProjectDir : string256; var RunName : string256); stdcall;
   external s_TASACS_Dll name '_LoadRun_@8'
procedure ObjFunc__(var Value : Double); stdcall;
   external s_TASACS_Dll name '_ObjFunc_@4'
(*procedure OnOptimisationFinished(); stdcall
   external s_TASACS_Dll name '_OnOptimisationFinished_@0'*)
procedure RunOpt__(var Value : Integer); stdcall;
   external s_TASACS_Dll name '_RunOpt_@4'
procedure SaveObsData__(); stdcall;
   external s_TASACS_Dll name '_SaveObsData@0'
procedure SaveRun__(); stdcall;
   external s_TASACS_Dll name '_SaveRun_@0'
procedure get_ActiveParam_Value(var Index : Integer; var Value : Double); stdcall;
   external s_TASACS_Dll name '_get_ActiveParam_Value@8'
procedure get_DataSource_(var DataSource, DataSourceIndex : Integer; var FProp, MProp : Double; var ObjType : Integer; var Weight, My : Double; var PlusGroupCode : Integer; var BootType; var Sigma : double; var BootFile : string32); stdcall;
   external s_TASACS_Dll name '_get_DataSource@44'
procedure get_DataSourceDimensions_(var Cat, Idx, FirstYear, LastYear, FirstAge, LastAge : Integer); stdcall;
   external s_TASACS_Dll name '_get_DataSourceDimensions@24'
procedure get_DataSourceValue_(var Cat, Idx, iYear, iAge : Integer; var Value : double); stdcall;
   external s_TASACS_Dll name '_get_DataSourceValue@20'
procedure get_F__(var Year, Age : Integer; var Value : Double); stdcall;
   external s_TASACS_Dll name '_get_F_@12'
procedure get_IndexInput_StockTitle_(var StockTitle : string256); stdcall;
   external s_TASACS_Dll name '_get_IndexInput_StockTitle@4'
procedure get_N__(var Year, Age : Integer; var Value : Double); stdcall;
   external s_TASACS_Dll name '_get_N_@12'
procedure get_ParamElm_Descr_(var Cat, Index, Year, Age : Integer; var Value : string50); stdcall;
   external s_TASACS_Dll name '_get_ParamElm_Descr@20'
procedure get_ParamElm_Flag_(var Cat, Index, Year, Age : Integer; var Value : Integer); stdcall;
   external s_TASACS_Dll name '_get_ParamElm_Flag@20'
procedure get_ParamElm_Value_(var Cat, Index, Year, Age : Integer; var Value : Double); stdcall;
   external s_TASACS_Dll name '_get_ParamElm_Value@20'
procedure get_Run_Prop_(var Prop : Integer; var RetVal : Double); stdcall;
   external s_TASACS_Dll name '_get_Run_Prop@8'
procedure get_Run_Prop_Str_(var Prop : Integer; var RetVal : string256); stdcall;
   external s_TASACS_Dll name '_get_Run_Prop_Str@8'
procedure get_categoryname__(var Cat : Integer; var Res : string256); stdcall;
   external s_TASACS_Dll name '_get_categoryname_@8'
procedure set_ActiveParam_Value(var Index : Integer; var Value : Double); stdcall;
   external s_TASACS_Dll name '_set_ActiveParam_Value@8'
procedure set_DataSource_(var DataSource, DataSourceIndex : Integer; var FProp, MProp; var ObjType : Integer; var Weight, My : Double; var PlusGroupCode : Integer; var BootType;  var Sigma : double; var BootFile : string32); stdcall;
   external s_TASACS_Dll name '_set_DataSource@44'
procedure set_DataSourceDimensions_(var Cat, Idx, FirstYear, LastYear, FirstAge, LastAge : Integer); stdcall;
   external s_TASACS_Dll name '_set_DataSourceDimensions@24'
procedure set_DataSourceValue_(var Cat, Idx, iYear, iAge : Integer; var Value : double); stdcall;
   external s_TASACS_Dll name '_set_DataSourceValue@20'
procedure set_IndexInput_StockTitle_(var StockTitle : string256); stdcall;
   external s_TASACS_Dll name '_set_IndexInput_StockTitle@4'
procedure set_ParamElm_Descr_(var Cat, Index, Year, Age : Integer; var Value : string50); stdcall;
   external s_TASACS_Dll name '_set_ParamElm_Descr@20'
procedure set_ParamElm_Flag_(var Cat, Index, Year, Age : Integer; var Value : Integer); stdcall;
   external s_TASACS_Dll name '_set_ParamElm_Flag@20'
procedure set_ParamElm_Value_(var Cat, Index, Year, Age : Integer; var Value : Double); stdcall;
   external s_TASACS_Dll name '_set_ParamElm_Value@20'
procedure set_Run_Prop_(var Prop : Integer; var Value : Double); stdcall;
   external s_TASACS_Dll name '_set_Run_Prop@8'
procedure set_Run_Prop_Str_(var Prop : Integer; var Value : string256); stdcall;
   external s_TASACS_Dll name '_set_Run_Prop_Str@8'
// Helpers

procedure CreateNewProject(ProjectDir :  String; FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass : Integer);
procedure LoadRun(ProjectDir, RunName :  String);
//procedure SaveModel();

procedure Execute(CmdId : Integer; Param1 : Integer = 0); stdcall;
function RunOpt() : Boolean;

//function get_IndexInput : TIndexInputPtr;
function get_IndexInput_StockTitle() : string;
procedure set_IndexInput_StockTitle(Value : string);
function get_Run_Prop(Prop : Integer) : double;
procedure set_Run_Prop(Prop : Integer; Value : double);
function get_Run_Prop_Str(Prop : Integer) : string;
procedure set_Run_Prop_Str(Prop : Integer; Value : string);
procedure get_DataSource(DataSource, DataSourceIndex : Integer; var FProp, MProp : double; var ObjType : Integer; var Weight, My : double; var PlusGroupCode : Integer; var BootType : Integer; var Sigma : double; var BootFile : string);
procedure set_DataSource(DataSource, DataSourceIndex : Integer; FProp, MProp : double; ObjType : Integer; Weight, My : double; PlusGroupCode : Integer; BootType : Integer; Sigma : double; BootFile : string);
function get_DataSourceValue(Cat, Idx, iYear, iAge : Integer) : double;
procedure set_DataSourceValue(Cat, Idx, iYear, iAge : Integer; Value : double);
procedure get_DataSourceDimensions(Cat, Idx : Integer; var FirstYear, LastYear, FirstAge, LastAge : Integer);
procedure set_DataSourceDimensions(Cat, Idx, FirstYear, LastYear, FirstAge, LastAge : Integer);
//function get_error : string;
function get_categoryname(Cat : Integer) : string;

function FirstFleet : Integer;
function NumYears : Integer;
function NumAges : Integer;
//function get_ParamElm(Cat, Index, Year, Age : Integer) : TParamElmPtr;
function get_N(Year, Age : Integer) : double;
function get_F(Year, Age : Integer) : double;


const cmdCloseRun = 0;
const cmdRunOpt = 1;
const cmdResetOpt = 2;

implementation


procedure Execute(CmdId, Param1 : Integer); stdcall;
var
   Val1, Val2, _CmdId, _Param1 : Integer;
begin
   _CmdId := CmdId;
   _Param1 := Param1;
   Execute__(_CmdId, _Param1);
//   asm add esp, 4; end;
end; // Optimise


function RunOpt() : Boolean;
var
   Val : Integer;
begin
   RunOpt__(Val);
   Result := Boolean(Val);
end; // RunOpt


(*Function get_IndexInput : TIndexInputPtr;
var
   _pVal : TIndexInputPtr;
begin
   _pVal := get_IndexInput__;
   Result := _pVal;
end; // get_IndexInput*)


(*
procedure LoadRun(Val : String);
var
   _Val : string256;
begin
   Val := leftstr(trim(Val), sizeof(string256) - 1);
   if Val = '' then exit;
   Val[high(string256)] := #0;
   strcopy(pchar(@_Val[1]), pchar(Val));
   LoadRun__(_Val);


end; // LoadRun


procedure SaveRun(Val : String);
var
   _Val : string256;
begin
   Val := leftstr(trim(Val), sizeof(string256) - 1);
   if Val = '' then exit;
   Val[high(string256)] := #0;
   strcopy(pchar(@_Val[1]), pchar(Val));
   SaveRun__(_Val);

end; // SaveRun
*)

procedure CreateNewProject(ProjectDir :  String; FirstYear, LastYear, FirstAge, LastAge, NumFleets, NumSSB, NumBiomass : Integer);
var
   _ProjectDir : string256;
   _FirstYear, _LastYear, _FirstAge, _LastAge, _NumFleets, _NumSSB, _NumBiomass : Integer;
   I : Integer;
begin
   ProjectDir := leftstr(trim(ProjectDir), sizeof(string256) - 1);
   if ProjectDir = '' then exit;
   FillChar(_ProjectDir, sizeof(string256), ' ');
   for I := 1 to Length(ProjectDir) do
      _ProjectDir[I] := ProjectDir[I];
   _FirstYear := FirstYear;
   _LastYear := LastYear;
   _FirstAge := FirstAge;
   _LastAge := LastAge;
   _NumFleets := NumFleets;
   _NumSSB := NumSSB;
   _NumBiomass := NumBiomass;
   CreateNewProject__(_ProjectDir, _FirstYear, _LastYear, _FirstAge, _LastAge, _NumFleets, _NumSSB, _NumBiomass);
end; // CreateNewProject


procedure LoadRun(ProjectDir, RunName : String);
var
   _ProjectDir : string256;
   _RunName : string256;
   I : Integer;
begin
   ProjectDir := leftstr(trim(ProjectDir), sizeof(string256) - 1);
   if ProjectDir = '' then exit;
   FillChar(_ProjectDir, sizeof(string256), ' ');
   for I := 1 to Length(ProjectDir) do
      _ProjectDir[I] := ProjectDir[I];
   RunName := leftstr(trim(RunName), sizeof(string256) - 1);
   if RunName = '' then exit;
   FillChar(_RunName, sizeof(string256), ' ');
   for I := 1 to Length(RunName) do
      _RunName[I] := RunName[I];
   LoadRun__(_ProjectDir, _RunName);
end; // LoadRun



(*function get_error : string;
var
   _Val : string256;
begin
   _Val := get_error__;
   Result := trim(_Val);
end;*)


function get_categoryname(Cat : Integer) : string;
var
   _Cat : Integer;
   _Val : string256;
begin
   _Cat := Cat;
   get_categoryname__(_Cat, _Val);
   Result := trim(_Val);
end; // get_categoryname


function FirstFleet : Integer;
begin
   Result := 1
end; // FirstFleet


function NumYears : Integer;
begin
   Result := round(get_Run_Prop(propLastYear) - get_Run_Prop(propFirstYear) + 1);
end; // NumYears


function NumAges : Integer;
begin
   Result := round(get_Run_Prop(propLastAge) - get_Run_Prop(propFirstAge) + 1);
end; // NumAges


(*function get_ParamElm(Cat, Index, Year, Age : Integer) : TParamElmPtr;
var
   _Val : TParamElmPtr;
   _Cat, _Index, _Year, _Age : Integer;
begin
   _Val := get_ParamElm__(Cat, Index, Year, Age);
   Result := _Val;
end; // get_ParamElm*)


function get_IndexInput_StockTitle() : string;
var
   I : Integer;
   _Value : string256;
begin
   get_IndexInput_StockTitle_(_Value);
   Result := trim(_Value)
end; // get_IndexInput_StockTitle


procedure set_IndexInput_StockTitle(Value : string);
var
   I : Integer;
   _Value : string256;
begin
   if Value = '' then exit;
   FillChar(_Value, sizeof(string256), ' ');
   for I := 1 to min(sizeof(string256), Length(Value)) do
      _Value[I] := Value[I];
   set_IndexInput_StockTitle_(_Value);
end; // set_IndexInput_StockTitle


function get_Run_Prop(Prop : Integer) : double;
var
   _Val : double;
   _Prop : Integer;
begin
   get_Run_Prop_(Prop, _Val);
   Result := _Val;
end; // get_Run_Prop


procedure set_Run_Prop(Prop : Integer; Value : double);
var
   _Prop : Integer;
   _Val : double;
begin
   _Val := Value;
   set_Run_Prop_(Prop, _Val);
end; // set_Run_Prop


function get_DataSourceValue(Cat, Idx, iYear, iAge : Integer) : double;
var
   _Cat, _Idx, _iYear, _iAge : Integer;
   _Val : double;
begin
   _Cat := Cat;
   _Idx := Idx;
   _iYear := iYear;
   _iAge := iAge;
   get_DataSourceValue_(_Cat, _Idx, _iYear, _iAge, _Val);
   Result := _Val;
end; // get_DataSourceValue


procedure set_DataSourceValue(Cat, Idx, iYear, iAge : Integer; Value : double);
var
   _Cat, _Idx, _iYear, _iAge : Integer;
   _Val : double;
begin
   _Cat := Cat;
   _Idx := Idx;
   _iYear := iYear;
   _iAge := iAge;
   _Val := Value;
   set_DataSourceValue_(_Cat, _Idx, _iYear, _iAge, _Val);
end; // set_DataSourceValue



procedure get_DataSourceDimensions(Cat, Idx : Integer; var FirstYear, LastYear, FirstAge, LastAge : Integer);
var
   _Cat, _Idx : Integer;
   _FirstYear, _LastYear, _FirstAge, _LastAge : Integer;
begin
   _Cat := Cat;
   _Idx := Idx;
   get_DataSourceDimensions_(_Cat, _Idx, _FirstYear, _LastYear, _FirstAge, _LastAge);
   FirstYear := _FirstYear;
   LastYear := _LastYear;
   FirstAge := _FirstAge;
   LastAge := _LastAge;
end;


procedure set_DataSourceDimensions(Cat, Idx, FirstYear, LastYear, FirstAge, LastAge : Integer);
var
   _Cat, _Idx : Integer;
   _FirstYear, _LastYear, _FirstAge, _LastAge : Integer;
begin
   _Cat := Cat;
   _Idx := Idx;
   _FirstYear := FirstYear;
   _LastYear := LastYear;
   _FirstAge := FirstAge;
   _LastAge := LastAge;
   set_DataSourceDimensions_(_Cat, _Idx, _FirstYear, _LastYear, _FirstAge, _LastAge);
end; // set_DataSourceDimensions

function get_Run_Prop_Str(Prop : Integer) : string;
var
   I : Integer;
   _Value : string256;
begin
   get_Run_Prop_Str_(Prop, _Value);
   Result := trim(_Value)
end; // get_Run_Prop_Str


procedure set_Run_Prop_Str(Prop : Integer; Value : string);
var
   I : Integer;
   _Value : string256;
begin
   if Value = '' then exit;
   FillChar(_Value, sizeof(string256), ' ');
   for I := 1 to min(sizeof(string256), Length(Value)) do
      _Value[I] := Value[I];
   set_Run_Prop_Str_(Prop, _Value);
end; // set_Run_Prop_Str


procedure get_DataSource(DataSource, DataSourceIndex : Integer; var FProp, MProp : double; var ObjType : Integer; var Weight, My : double; var PlusGroupCode : Integer; var BootType : Integer; var Sigma : double; var BootFile : string);
var
   _DataSource, _DataSourceIndex : Integer;
   _FProp, _MProp, _Weight, _My : double;
   _ObjType, _PlusGroupCode : Integer;
   _BootType : Integer;
   _Sigma : double;
   _BootFile : string32;
begin
   _DataSource := DataSource;
   _DataSourceIndex := DataSourceIndex;
   get_DataSource_(_DataSource, _DataSourceIndex, _FProp, _MProp, _ObjType, _Weight, _My, _PlusGroupCode, _BootType, _Sigma, _BootFile);
   FProp := _FProp;
   MProp := _MProp;
   ObjType := _ObjType;
   Weight := _Weight;
   My := _My;
   PlusGroupCode := _PlusGroupCode;
   BootType := _BootType;
   Sigma := _Sigma;
   BootFile := trim(_BootFile);
end; // get_DataSource


procedure set_DataSource(DataSource, DataSourceIndex : Integer; FProp, MProp : double; ObjType : Integer; Weight, My : double; PlusGroupCode : Integer; BootType : Integer;  Sigma : double; BootFile : string);
var
   _DataSource, _DataSourceIndex : Integer;
   _FProp, _MProp, _Weight, _My : double;
   _ObjType, _PlusGroupCode : Integer;
   _BootType : Integer;
   _Sigma : double;
   _BootFile : string32;
   I : Integer;
begin
   _DataSource := DataSource;
   _DataSourceIndex := DataSourceIndex;
   _FProp := FProp;
   _MProp := MProp;
   _ObjType := ObjType;
   _Weight := Weight;
   _My := My;
   _PlusGroupCode := PlusGroupCode;
   _BootType := BootType;
   _Sigma := Sigma;
   if BootFile = '' then BootFile := 'NA';
   FillChar(_BootFile, sizeof(string32), ' ');
   for I := 1 to min(sizeof(string32), Length(BootFile)) do
      _BootFile[I] := BootFile[I];
   set_DataSource_(_DataSource, _DataSourceIndex, _FProp, _MProp, _ObjType, _Weight, _My, _PlusGroupCode, _BootType, _Sigma, _BootFile);
end; // set_DataSource


function get_N(Year, Age : Integer) : double;
var
   _Val : double;
   _Year, _Age : Integer;
begin
   get_N__(Year, Age, _Val);
   Result := _Val;
end;


function get_F(Year, Age : Integer) : double;
var
   _Val : double;
   _Year, _Age : Integer;
begin
   get_F__(Year, Age, _Val);
   Result := _Val;
end;


end.
